{ *** tryMysql 主单元文件 *** }
unit unit_tryMysql;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, mysql55conn, sqldb, FileUtil, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids;

type

  { TForm1 }

  TForm1 = class(TForm)
    btn_conn: TButton;
    btn_close: TButton;
    btn_query: TButton;
    cmb_dblist: TComboBox;
    cmb_tblist: TComboBox;
    lbe_db: TLabeledEdit;
    lbl_db: TLabel;
    lbl_tb: TLabel;
    lbl_fld: TLabel;
    lbe_sql: TLabeledEdit;
    lbe_host: TLabeledEdit;
    lbe_user: TLabeledEdit;
    lbe_pass: TLabeledEdit;
    lsb_fblist: TListBox;
    mysql55_conn: TMySQL55Connection;
    sql_query: TSQLQuery;
    sql_tran: TSQLTransaction;
    stb_info: TStatusBar;
    sgd_table: TStringGrid;
    { *** 退出程序 *** }
    procedure btn_closeClick(Sender: TObject);

    { *** 连接到服务器 *** }
    procedure btn_connClick(Sender: TObject);

    { *** 发送查询 ***}
    procedure btn_queryClick(Sender: TObject);

    { *** 数据库被选择 *** }
    procedure cmb_dblistSelect(Sender: TObject);

    { *** 表被选择 *** }
    procedure cmb_tblistSelect(Sender: TObject);

    { *** 创建窗体 *** }
    procedure FormCreate(Sender: TObject);

    { *** 设置Grid标题 *** }
    procedure sendGridTitle(table: TStringGrid; list: TStringList);

    {
    *** 自动TStringGrid 列宽 ***
    @param table TStringGrid
    }
    procedure autoGridWidth(table: TStringGrid);

    {
    *** 发送消息到状态栏 ***
    @param info string 消息内容
    @param i integer 消息位置
    }
    procedure sendStatus(info: string; i: integer = 0);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

const
  { 定义要执行 ExecSQL 方法的SQL前缀 }
  notSql =
    'INSERT,UPDATE,DELETE,DROP,CREATE,ALTER,OPTIMIZE,REPLACE,LOAD,USE,FLUSH,KILL,SET,START,COMMIT,ROLLBACK';

implementation

{$R *.lfm}

{ TForm1 }

{ *** 退出程序 *** }
procedure TForm1.btn_closeClick(Sender: TObject);
begin
  sql_query.Close;
  mysql55_conn.Close();
  Close;
end;

{ *** 连接到服务器 *** }
procedure TForm1.btn_connClick(Sender: TObject);

begin
  mysql55_conn.HostName := lbe_host.Text;
  mysql55_conn.UserName := lbe_user.Text;
  mysql55_conn.Password := lbe_pass.Text;
  mysql55_conn.DatabaseName := lbe_db.Text;

  try
    mysql55_conn.Open;
  except
    on E: Exception do
    begin
      sendStatus('无法连接到服务器 ' + lbe_host.Text);
      ShowMessage('连接错误' + sLineBreak + E.Message);
      exit;
    end;

  end;
  sql_query.SQL.Text := 'set names utf8';
  sql_query.ExecSQL;

  if (mysql55_conn.Connected) then
  begin

    sendStatus('已连接到服务器 ' + lbe_host.Text);
    sendStatus('获取可用数据库列表 ...');
    sql_query.SQL.Text := 'SHOW DATABASES';
    sql_query.Open;
    cmb_dblist.Items.Clear;
    cmb_dblist.Items.Add('选择数据库');
    cmb_dblist.ItemIndex := 0;
    while not sql_query.EOF do
    begin
      cmb_dblist.Items.Add(sql_query.Fields[0].AsString);
      sql_query.Next;
    end;
    sql_query.Close;
    sendStatus('数据库列表载入完成！');
  end;
end;


{ *** 发送查询 ***}
procedure TForm1.btn_queryClick(Sender: TObject);
var
  Data: TStringList;
  i, b, intCount: integer;
  strKey: string;
begin

  if (lbe_sql.Caption = '') then
    exit;
  sendStatus('发送查询 ' + lbe_sql.Caption);
  mysql55_conn.Close();


  {*** 显示表统计含存储引擎 ***
  SHOW TABLE STATUS FROM test;
  ==============================
  *** 显示表结构 ***
  SHOW CREATE TABLE testt;
  }
  sql_query.PacketRecords := -1;

  sql_query.SQL.Text := lbe_sql.Caption;
  //ConvertEncoding(lbe_sql.Caption,'utf8','ISO-8859-1');
  //showmessage(GuessEncoding(lbe_sql.Caption));
  //exit;
  //ConvertEncoding

  i := pos(' ', lbe_sql.Caption);

  { *** 获取全部记录时， PacketRecords 需要设置为，-1 *** }
  { 参看这里：http://forum.lazarus.freepascal.org/index.php/topic,4680.msg28779.html#msg28779 }

  strKey := UpperCase(leftStr(lbe_sql.Caption, i - 1));
  sendStatus('等待接收结果 ', 1);
  Application.ProcessMessages;
  {
  更新 mysql 数据库，留意
  SHOW VARIABLES LIKE 'character_set_%'中的
  character_set_connection 编码类别 如 latin1
  如果不行，得配置my.ini文件
  character-set-server=utf8
  }

  //showMessage(inttostr(pos(strKey, notSql))+'|'+strKey);
  try
    if pos(strKey, notSql) > 0 then
    begin
      { 对于Innodb表，需要开启事务，否则没办法完成相应操作 }
      sql_tran.StartTransaction;
      sql_query.ExecSQL;
      sql_tran.Commit;
    end
    else
      sql_query.Open;
  except
    on E: Exception do
    begin
      sendStatus('查询失败，请检查SQL语句');
      sendStatus('记录数', 1);
      ShowMessage('查询错误' + sLineBreak + E.Message);
      exit;
    end;
  end;
  if pos(strKey, notSql) > 0 then
  begin
    sendStatus('记录数', 1);
    ShowMessage('影响记录数 ' + IntToStr(sql_query.RowsAffected));
    exit;
  end;

  sendStatus('等待接收数据... ', 1);
  Application.ProcessMessages;
  { 设置表格Title 并设置 }
  Data := TStringList.Create;
  Data.Add('No.');
  for i := 0 to sql_query.FieldCount - 1 do
    Data.Add(sql_query.Fields[i].FieldName);

  sendGridTitle(sgd_table, Data);

  lsb_fblist.Items.Clear;
  sgd_table.RowCount := 1;
  sgd_table.RowCount := sql_query.RecordCount + 1;

  {
   * 不使用 sql_query.EOF 来判断数据是否读取完闭
   * 而使用 RecordCount 确定要读取的记录数
  }

  intCount := 0;
  for b := 1 to sql_query.RecordCount do
  begin
    Application.ProcessMessages;
    {
    *** 获取结果方法 ***
    * sql_query.Fields[0].AsString
    * sql_query.FieldByName('Field').AsString
    }
    sgd_table.Cells[0, b] := IntToStr(b);
    for i := 0 to sql_query.FieldCount - 1 do
    begin
      sgd_table.Cells[i + 1, b] :=
        sql_query.Fields[i].AsString;
    end;
    Inc(intCount);
    strKey := '';
    strKey := '总记录数 ' + IntToStr(sql_query.RecordCount);
    strKey := strKey + '，已取出 ' + IntToStr(intCount);
    sendStatus(strKey, 1);
    sql_query.Next;
  end;
  // 不好的显示状态 start
  strKey := '';
  strKey := '总记录数 ' + IntToStr(sql_query.RecordCount);
  strKey := strKey + '，已取出 ' + IntToStr(intCount);
  sendStatus(strKey, 1);
  // 不好的显示状态 end
  sql_query.Close;
  autoGridWidth(sgd_table);
end;

{ *** 数据库被选择 *** }
procedure TForm1.cmb_dblistSelect(Sender: TObject);
begin
  if (cmb_dblist.ItemIndex <= 0) then
    exit;

  {
  * 不清除为何为关闭连接
  * 难道是因为选择不同数据库
  * (反正，不关闭它无法切换数据库)
  }
  mysql55_conn.Close();

  begin
    // 选择数据库
    mysql55_conn.DatabaseName := cmb_dblist.Caption;
    sendStatus('选择数据库 ' + cmb_dblist.Caption);

    { *** 获取全部记录时， PacketRecords 需要设置为，-1 *** }
    { 参看这里：http://forum.lazarus.freepascal.org/index.php/topic,4680.msg28779.html#msg28779 }
    sql_query.PacketRecords := -1;

    try
      sql_query.SQL.Text := 'SHOW TABLES';
      sql_query.Open;
    except
      on E: Exception do
      begin
        sendStatus('选择数据库失败 ' + cmb_dblist.Caption);
        ShowMessage('查询错误' + sLineBreak + E.Message);
        exit;
      end;
    end;

    // sql_query.RecordCount; // 获取结果记i录数
    // sql_query.RowsAffected; // 影响记录数

    cmb_tblist.Items.Clear;
    cmb_tblist.Items.Add('选择表');
    cmb_tblist.ItemIndex := 0;

    while not sql_query.EOF do
    begin
      cmb_tblist.Items.Add(sql_query.Fields[0].AsString);
      sql_query.Next;
    end;
    sql_query.Close;
  end;
end;

{ *** 表被选择 *** }
procedure TForm1.cmb_tblistSelect(Sender: TObject);
var
  Data: TStringList;
  i, b: integer;
begin
  if (cmb_tblist.ItemIndex <= 0) then
    exit;
  sendStatus('显示表结构 ' + cmb_tblist.Items[cmb_tblist.ItemIndex]);
  mysql55_conn.Close();

  { *** 获取全部记录时， PacketRecords 需要设置为，-1 *** }
  { 参看这里：http://forum.lazarus.freepascal.org/index.php/topic,4680.msg28779.html#msg28779 }
  sql_query.PacketRecords := -1;

  try
    sql_query.SQL.Text := 'SHOW FULL FIELDS FROM ' + cmb_tblist.Caption;
    lbe_sql.Caption := sql_query.SQL.Text;
    sql_query.Open;
  except
    on E: Exception do
    begin
      sendStatus('选择表失败 ' + cmb_tblist.Caption);
      ShowMessage('查询错误' + sLineBreak + E.Message);
      exit;
    end;
  end;

  { 设置表格Title 并设置 }
  Data := TStringList.Create;
  Data.Add('No.');
  for i := 0 to sql_query.FieldCount - 1 do
    Data.Add(sql_query.Fields[i].FieldName);

  sendGridTitle(sgd_table, Data);

  lsb_fblist.Items.Clear;
  sgd_table.RowCount := 1;
  sgd_table.RowCount := sql_query.RecordCount + 1;

  {
   * 不使用 sql_query.EOF 来判断数据是否读取完闭
   * 而使用 RecordCount 确定要读取的记录数
  }
  for b := 1 to sql_query.RecordCount do
  begin
    {
    *** 获取结果方法 ***
    // sql_query.Fields[0].AsString
    // sql_query.FieldByName('Field').AsString
    }
    sgd_table.Cells[0, b] := IntToStr(b);
    for i := 0 to sql_query.FieldCount - 1 do
    begin
      sgd_table.Cells[i + 1, b] :=
        sql_query.Fields[i].AsString;
    end;
    lsb_fblist.Items.Add(sql_query.FieldByName('Field').AsString);
    sql_query.Next;
  end;
  sql_query.Close;
  autoGridWidth(sgd_table);

end;

{ *** 创建窗体 *** }
procedure TForm1.FormCreate(Sender: TObject);
begin
  { 系统时间显示乱码问题
   如果是修改你本程序中用到的日期格式
  look here http://freepascal.stack.nl/docs-html/rtl/sysutils/tformatsettings.html
  重新修改 ShortDateFormat 和 ShortTimeFormat 格式即可确保中文时间显示不乱码
  }

  { 设置默认的短日期、时间格式 }
  DefaultFormatSettings.ShortDateFormat := 'yyyy-M-d';
  DefaultFormatSettings.ShortTimeFormat := 'HH:mm';
end;

{ *** 设置Grid标题 *** }
procedure TForm1.sendGridTitle(table: TStringGrid; list: TStringList);
var
  i: integer;
begin
  // 设置列数
  table.ColCount := list.Count;
  for i := 0 to list.Count - 1 do
  begin
    // 设置列值
    table.Cells[i, 0] := list[i];// [列,行]
  end;
end;

{ *** 自动TStringGrid 列宽 *** }
procedure TForm1.autoGridWidth(table: TStringGrid);
var
  maxWidth, iStart, iEnd: integer;
begin
  for iStart := 0 to table.ColCount - 1 do
  begin
    maxWidth := 0;
    for iEnd := 0 to table.RowCount - 1 do
      if (maxWidth < length(table.Cells[iStart, iEnd])) then
        maxWidth := length(table.Cells[iStart, iEnd]);

    { 设置列宽 且宽度不超过 150 }
    if ((maxWidth * 6 + 9) > 150) then
      maxWidth := (150 div 6) - 9;
    {
    为什么 (*6-9) 我也不知道
    look here http://city193.blog.163.com/blog/static/3413652320084715714903/
    }
    table.ColWidths[iStart] := maxWidth * 6 + 9;
  end;

end;

{ *** 发送消息到状态栏 *** }
procedure TForm1.sendStatus(info: string; i: integer = 0);
begin
  stb_info.Panels[i].Text := info;
end;

end.
